home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / shapeg1a / frmshape.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-10-12  |  3.3 KB  |  114 lines
  1. VERSION 5.00
  2. Begin VB.Form frmShapes 
  3.    BackColor       =   &H00000000&
  4.    ClientHeight    =   3135
  5.    ClientLeft      =   165
  6.    ClientTop       =   450
  7.    ClientWidth     =   4680
  8.    ControlBox      =   0   'False
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   3135
  11.    ScaleWidth      =   4680
  12.    StartUpPosition =   3  'Windows Default
  13.    WindowState     =   2  'Maximized
  14.    Begin VB.Timer tmTimer 
  15.       Enabled         =   0   'False
  16.       Interval        =   500
  17.       Left            =   1800
  18.       Top             =   1320
  19.    End
  20.    Begin VB.Menu mnuFile 
  21.       Caption         =   "&File"
  22.       Begin VB.Menu mnuFileSettings 
  23.          Caption         =   "&Settings..."
  24.       End
  25.       Begin VB.Menu mnuFilePause 
  26.          Caption         =   "-"
  27.       End
  28.       Begin VB.Menu mnuFileExit 
  29.          Caption         =   "E&xit"
  30.       End
  31.    End
  32. Attribute VB_Name = "frmShapes"
  33. Attribute VB_GlobalNameSpace = False
  34. Attribute VB_Creatable = False
  35. Attribute VB_PredeclaredId = True
  36. Attribute VB_Exposed = False
  37. Option Explicit
  38. Dim Terminate As Integer
  39. Private Sub Angle()
  40. Dim pPoint As Pt, Ang As Currency, Obj As Currency
  41. Dim LLen As Currency, i As Currency
  42. Dim pStart As Pt, j As Long
  43. Dim Cur As Integer, Degrees As Integer
  44.     Ang = 30
  45.     pPoint = SetValues(ScaleWidth / 2, ScaleHeight / 2 - SHeight / 2)
  46.     pStart = pPoint
  47.     LLen = Cosine(Ang) * SHeight
  48.     If AutoClear Then Cls
  49.     Do
  50.         If Terminate Then
  51.             Terminate = False
  52.             Exit Sub
  53.         End If
  54.         Cur = Cur + 1
  55.         Degrees = Sets(Cur).Degrees
  56.         LLen = Cosine(Degrees) * Sets(Cur).Length
  57.         If Cur >= UBound(Sets) - 1 Then Cur = 0
  58.         DoEvents
  59.         i = Cosine(Ang) * LLen
  60.         Obj = Sine(Ang) * LLen
  61.         Line (pPoint.X, pPoint.Y)-(pPoint.X + Obj, pPoint.Y + i)
  62.         pPoint = SetValues(pPoint.X + Obj, pPoint.Y + i)
  63.         Ang = Ang + Abs(Degrees + 180)
  64.         If Ang > 360 Then Ang = Ang - 360
  65.         j = j + 1
  66.         If j > (360 * UBound(Sets)) Then Exit Sub
  67.     Loop Until IsSimilar(pPoint, pStart)
  68. End Sub
  69. Private Function IsSimilar(Point1 As Pt, Point2 As Pt) As Boolean
  70.     IsSimilar = Abs(ScaleX(Point1.Y, 1, 3) - ScaleX(Point2.Y, 1, 3)) < 2 And Abs(ScaleX(Point1.X, 1, 3) - ScaleX(Point2.X, 1, 3)) < 2
  71. End Function
  72. Private Function MakeRandom() As AngData
  73.     MakeRandom.Degrees = Rnd * 360
  74.     MakeRandom.Length = Rnd * (UBound(Sets) * -30) + 5030
  75. End Function
  76. Sub RandomSets()
  77. Dim i As Integer
  78.     For i = 1 To UBound(Sets)
  79.         Sets(i) = MakeRandom
  80.     Next i
  81. End Sub
  82. Private Sub Form_Click()
  83.     NextPhase
  84. End Sub
  85. Private Sub Form_DblClick()
  86. Static Clicked As Boolean
  87.     If Clicked Then End
  88.     Clicked = True
  89.     mnuFile.Visible = False
  90.     Do
  91.         DoEvents
  92.         SetNum Int(Rnd * 19) + 1
  93.         NextPhase
  94.     Loop
  95. End Sub
  96. Private Sub mnuFileExit_Click()
  97.     End
  98. End Sub
  99. Private Sub mnuFileSettings_Click()
  100.     Terminate = True
  101.     frmSettings.Show vbModal
  102. End Sub
  103. Function RandomElement() As Integer
  104.     RandomElement = Int(Rnd * 150) + 105
  105. End Function
  106. Private Sub tmTimer_Timer()
  107.     NextPhase
  108. End Sub
  109. Sub NextPhase()
  110.     ForeColor = RGB(RandomElement, RandomElement, RandomElement)
  111.     RandomSets
  112.     Angle
  113. End Sub
  114.